home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / opt.mod (.txt) < prev    next >
Oberon Text  |  1996-06-09  |  36KB  |  869 lines
  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax20b.Scn.Fnt
  5. Syntax24b.Scn.Fnt
  6. Syntax24.Scn.Fnt
  7. Syntax10b.Scn.Fnt
  8. Syntax10i.Scn.Fnt
  9. Courier10.Scn.Fnt
  10. (* AMIGA *)
  11. (* Notify Ralf for maintenance of Non-FPU source *)
  12. MODULE OPT;    (* NW, RC 6.3.89 / 9.2.94 *)
  13.     IMPORT
  14.         OPS, OPM;
  15.     CONST
  16.         MaxConstLen* = OPS.MaxStrLen;
  17.     TYPE
  18.         Const* = POINTER TO ConstDesc;
  19.         Object* = POINTER TO ObjDesc;
  20.         Struct* = POINTER TO StrDesc;
  21.         Node* = POINTER TO NodeDesc;
  22.         ConstExt* = POINTER TO OPS.String;
  23.         ConstDesc* = RECORD
  24.             ext*: ConstExt;    (* string or code for code proc *)
  25.             intval*: LONGINT;    (* constant value or adr, proc par size, text position or least case label *)
  26.             intval2*: LONGINT;    (* string length, proc var size or larger case label *)
  27.             setval*: SET;    (* constant value, procedure body present or "ELSE" present in case *)
  28.             realval*: LONGREAL    (* real or longreal constant value *)
  29.         END ;
  30.         ObjDesc* = RECORD
  31.             left*, right*, link*, scope*: Object;
  32.             name*: OPS.Name;
  33.             leaf*: BOOLEAN;
  34.             mode*, mnolev*: SHORTINT;    (* mnolev < 0 -> mno = -mnolev *)
  35.             vis*: SHORTINT;    (* 0: internal; 1: external; 2: externalR *)
  36.             typ*: Struct;
  37.             conval*: Const;
  38.             adr*, linkadr*: LONGINT
  39.         END ;
  40.         StrDesc* = RECORD
  41.             form*, comp*, mno*, extlev*: SHORTINT;
  42.             ref*, sysflag*: INTEGER;
  43.             n*, size*, tdadr*, offset*, txtpos*: LONGINT;
  44.             BaseTyp*: Struct;
  45.             link*, strobj*: Object
  46.         END ;
  47.         NodeDesc* = RECORD
  48.             left*, right*, link*: Node;
  49.             class*, subcl*: SHORTINT;
  50.             readonly*: BOOLEAN;
  51.             typ*: Struct;
  52.             obj*: Object;
  53.             conval*: Const
  54.         END ;
  55. (* Objects:
  56.     mode  | adr   conval  link     scope    leaf
  57.     ---------------------------------------------
  58.     Undef |                                        Not used
  59.     Var   | adr           next              regopt Glob or loc var or proc value parameter
  60.     VarPar| vadr          next              regopt Procedure var parameter
  61.     Con   |       val                              Constant
  62.     Fld   | off           next                     Record field
  63.     Typ   |                                        Named type
  64.     LProc |       sizes   firstpar scope    leaf   Local procedure
  65.     XProc | pno   sizes   firstpar scope    leaf   External procedure
  66.     SProc | fno   sizes                            Standard procedure
  67.     CProc |       code    firstpar scope           Code procedure
  68.     IProc | pno   sizes            scope    leaf   Interrupt procedure
  69.     Mod   | key                    scope           Module
  70.     Head  | txtpos        owner    firstvar        Scope anchor
  71.     TProc | index sizes   firstpar scope    leaf   Bound procedure, index = 10000H*mthno+pno
  72.                                                     
  73. Structures:
  74.     form    comp  | n      BaseTyp   link     mno  tdadr  offset txtpos   sysflag
  75.     -----------------------------------------------------------------------------
  76.     Undef   Basic |
  77.     Byte    Basic |
  78.     Bool    Basic |
  79.     Char    Basic |
  80.     SInt    Basic |
  81.     Int     Basic |
  82.     LInt    Basic |
  83.     Real    Basic |
  84.     LReal   Basic |
  85.     Set     Basic |
  86.     String  Basic |
  87.     NilTyp  Basic |
  88.     NoTyp   Basic |
  89.     Pointer Basic |        PBaseTyp           mno                txtpos   sysflag
  90.     ProcTyp Basic |        ResTyp    params   mno                txtpos   sysflag
  91.     Comp    Array | nofel  ElemTyp            mno                txtpos   sysflag
  92.     Comp    DynArr| dim    ElemTyp            mno         lenoff txtpos   sysflag
  93.     Comp    Record| nofmth RBaseTyp  fields   mno  tdadr         txtpos   sysflag
  94. Nodes:
  95. design   = Nvar|Nvarpar|Nfield|Nderef|Nindex|Nguard|Neguard|Ntype|Nproc.
  96. expr     = design|Nconst|Nupto|Nmop|Ndop|Ncall.
  97. nextexpr = NIL|expr.
  98. ifstat   = NIL|Nif.
  99. casestat = Ncaselse.
  100. sglcase  = NIL|Ncasedo.
  101. stat     = NIL|Ninittd|Nenter|Nassign|Ncall|Nifelse|Ncase|Nwhile|Nrepeat|
  102.            Nloop|Nexit|Nreturn|Nwith|Ntrap.
  103.               class     subcl     obj      left      right     link      
  104.               ---------------------------------------------------------
  105. design        Nvar                var                          nextexpr
  106.               Nvarpar             varpar                       nextexpr
  107.               Nfield              field    design              nextexpr
  108.               Nderef                       design              nextexpr
  109.               Nindex                       design    expr      nextexpr
  110.               Nguard                       design              nextexpr (typ = guard type)
  111.               Neguard                      design              nextexpr (typ = guard type)
  112.               Ntype               type                         nextexpr
  113.               Nproc     normal    proc                         nextexpr
  114.                         super     proc                         nextexpr
  115. expr          design
  116.               Nconst              const                                 (val = node^.conval)
  117.               Nupto                        expr      expr      nextexpr 
  118.               Nmop      not                expr                nextexpr
  119.                         minus              expr                nextexpr
  120.                         is        tsttype  expr                nextexpr
  121.                         conv               expr                nextexpr
  122.                         abs                expr                nextexpr
  123.                         cap                expr                nextexpr
  124.                         odd                expr                nextexpr
  125.                         adr                expr                nextexpr SYSTEM.ADR
  126.                         cc                 Nconst              nextexpr SYSTEM.CC
  127.                         val                expr                nextexpr SYSTEM.VAL
  128.               Ndop      times              expr      expr      nextexpr
  129.                         slash              expr      expr      nextexpr
  130.                         div                expr      expr      nextexpr
  131.                         mod                expr      expr      nextexpr
  132.                         and                expr      expr      nextexpr
  133.                         plus               expr      expr      nextexpr
  134.                         minus              expr      expr      nextexpr
  135.                         or                 expr      expr      nextexpr
  136.                         eql                expr      expr      nextexpr
  137.                         neq                expr      expr      nextexpr
  138.                         lss                expr      expr      nextexpr
  139.                         leq                expr      expr      nextexpr
  140.                         grt                expr      expr      nextexpr
  141.                         geq                expr      expr      nextexpr
  142.                         in                 expr      expr      nextexpr
  143.                         ash                expr      expr      nextexpr
  144.                         msk                expr      Nconst    nextexpr
  145.                         len                design    Nconst    nextexpr
  146.                         bit                expr      expr      nextexpr SYSTEM.BIT
  147.                         lsh                expr      expr      nextexpr SYSTEM.LSH
  148.                         rot                expr      expr      nextexpr SYSTEM.ROT
  149.               Ncall               fpar     design    nextexpr  nextexpr
  150. nextexpr      NIL
  151.               expr
  152. ifstat        NIL
  153.               Nif                          expr      stat      ifstat
  154. casestat      Ncaselse                     sglcase   stat            (minmax = node^.conval)
  155. sglcase       NIL
  156.               Ncasedo                      Nconst    stat      sglcase
  157. stat          NIL
  158.               Ninittd                                          stat     (of node^.typ)
  159.               Nenter              proc     stat      stat      stat     (proc=NIL for mod)
  160.               Nassign   assign             design    expr      stat
  161.                         newfn              design              stat
  162.                         incfn              design    expr      stat
  163.                         decfn              design    expr      stat
  164.                         inclfn             design    expr      stat
  165.                         exclfn             design    expr      stat
  166.                         copyfn             design    expr      stat
  167.                         getfn              design    expr      stat     SYSTEM.GET
  168.                         putfn              expr      expr      stat     SYSTEM.PUT
  169.                         getrfn             design    Nconst    stat     SYSTEM.GETREG
  170.                         putrfn             Nconst    expr      stat     SYSTEM.PUTREG
  171.                         sysnewfn           design    expr      stat     SYSTEM.NEW
  172.                         movefn             expr      expr      stat     SYSTEM.MOVE
  173.                                                                         (right^.link = 3rd par)
  174.               Ncall               fpar     design    nextexpr  stat
  175.               Nifelse                      ifstat    stat      stat
  176.               Ncase                        expr      casestat  stat
  177.               Nwhile                       expr      stat      stat
  178.               Nrepeat                      stat      expr      stat
  179.               Nloop                        stat                stat 
  180.               Nexit                                            stat 
  181.               Nreturn             proc     nextexpr            stat     (proc = NIL for mod)
  182.               Nwith                        ifstat    stat      stat
  183.               Ntrap                                  expr      stat
  184.     CONST
  185.         maxImps = 31;    (* must be < 128 *)
  186.         topScope*: Object;
  187.         undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*,
  188.         realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*: Struct;
  189.         nofGmod*: SHORTINT;    (*nof imports*)
  190.         GlbMod*:  ARRAY maxImps OF Object;    (* GlbMod[i]^.mode = exported module number *)
  191.         SYSimported*: BOOLEAN;
  192.     CONST
  193.         (* object modes *)
  194.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  195.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  196.         (* structure forms *)
  197.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  198.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  199.         Pointer = 13; ProcTyp = 14; Comp = 15;
  200.         (* composite structure forms *)
  201.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  202.         (*function number*)
  203.         assign = 0;
  204.         haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4;
  205.         entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
  206.         shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
  207.         inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
  208.         (*SYSTEM function number*)
  209.         adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
  210.         getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
  211.         bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31; callfn = 33;        (*<<OJ*)
  212.         (* module visibility of objects *)
  213.         internal = 0; external = 1; externalR = 2;
  214.         firstStr = 16;
  215.         maxStruct = OPM.MaxStruct;    (* must be < 256 *)
  216.         maxUndPtr = 64;
  217.         NotYetExp = 0;
  218.         universe, syslink: Object;
  219.         strno, udpinx: INTEGER;
  220.         nofExp: SHORTINT;
  221.         nofhdfld: LONGINT;
  222.         undPtr: ARRAY maxUndPtr OF Struct;
  223.     PROCEDURE Init*;
  224.     BEGIN topScope := universe; strno := 0; udpinx := 0; nofGmod := 0; SYSimported := FALSE
  225.     END Init;
  226.     PROCEDURE Close*;
  227.         VAR i: INTEGER;
  228.     BEGIN i := 0;
  229.         WHILE i < maxImps DO GlbMod[i] := NIL; INC(i) END    (* garbage collection *)
  230.     END Close;
  231.     PROCEDURE err(n: INTEGER);
  232.     BEGIN OPM.err(n)
  233.     END err;
  234.     PROCEDURE NewConst*(): Const;
  235.         VAR const: Const;
  236.     BEGIN NEW(const); (*const^.ext := NIL;*) RETURN const
  237.     END NewConst;
  238.     PROCEDURE NewObj*(): Object;
  239.         VAR obj: Object;
  240.     BEGIN NEW(obj); (*obj^.left := NIL; obj^.right := NIL; obj^.link := NIL; obj^.scope := NIL; *)
  241.         (*obj^.typ := NIL; obj^.conval := NIL;*) RETURN obj
  242.     END NewObj;
  243.     PROCEDURE NewStr*(form, comp: SHORTINT): Struct;
  244.         VAR typ: Struct;
  245.     BEGIN NEW(typ); (*typ^.link := NIL; typ^.strobj := NIL;*)
  246.         typ^.form := form; typ^.comp := comp;
  247.         (*typ^.mno := 0; typ^.ref := 0; typ^.sysflag := 0; typ^.extlev := 0; typ^.n := 0;*)
  248.         typ^.tdadr := OPM.TDAdrUndef; typ^.offset := OPM.TDAdrUndef;
  249.         typ^.txtpos := OPM.errpos; typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ
  250.     END NewStr;
  251.     PROCEDURE NewNode*(class: SHORTINT): Node;
  252.         VAR node: Node;
  253.     BEGIN
  254.         NEW(node); node^.class := class; (*node^.left := NIL; node^.right := NIL; node^.link := NIL;*)
  255.         (*node^.typ := NIL; node^.obj := NIL; node^.conval := NIL;*)
  256.         RETURN node
  257.     END NewNode;
  258.     PROCEDURE NewExt*(): ConstExt;
  259.         VAR ext: ConstExt;
  260.     BEGIN NEW(ext); RETURN ext
  261.     END NewExt;
  262.     PROCEDURE FindImport*(mod: Object; VAR res: Object);
  263.         VAR obj: Object;
  264.     BEGIN obj := mod^.scope;
  265.         LOOP
  266.             IF obj = NIL THEN EXIT END ;
  267.             IF OPS.name < obj^.name THEN obj := obj^.left
  268.             ELSIF OPS.name > obj^.name THEN obj := obj^.right
  269.             ELSE (*found*)
  270.                 IF (obj^.mode = Typ) & (obj^.vis = internal) THEN obj := NIL END ;
  271.                 EXIT
  272.             END
  273.         END ;
  274.         res := obj
  275.     END FindImport;
  276.     PROCEDURE Find*(VAR res: Object);
  277.         VAR obj, head: Object;
  278.     BEGIN head := topScope;
  279.         LOOP obj := head^.right;
  280.             LOOP
  281.                 IF obj = NIL THEN EXIT END ;
  282.                 IF OPS.name < obj^.name THEN obj := obj^.left
  283.                 ELSIF OPS.name > obj^.name THEN obj := obj^.right
  284.                 ELSE (*found*) EXIT
  285.                 END
  286.             END ;
  287.             IF obj # NIL THEN EXIT END ;
  288.             head := head^.left;
  289.             IF head = NIL THEN EXIT END
  290.         END ;
  291.         res := obj
  292.     END Find;
  293.     PROCEDURE FindField*(VAR name: OPS.Name; typ: Struct; VAR res: Object);
  294.         VAR obj: Object;
  295.     BEGIN 
  296.         WHILE typ # NIL DO obj := typ^.link;
  297.             WHILE obj # NIL DO
  298.                 IF name < obj^.name THEN obj := obj^.left
  299.                 ELSIF name > obj^.name THEN obj := obj^.right
  300.                 ELSE (*found*) res := obj; RETURN
  301.                 END
  302.             END ;
  303.             typ := typ^.BaseTyp
  304.         END ;
  305.         res := NIL
  306.     END FindField;
  307.     PROCEDURE Insert*(VAR name: OPS.Name; VAR obj: Object);
  308.         VAR ob0, ob1: Object; left: BOOLEAN;
  309.     BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE;
  310.         LOOP
  311.             IF ob1 # NIL THEN
  312.                 IF name < ob1^.name THEN ob0 := ob1; ob1 := ob0^.left; left := TRUE
  313.                 ELSIF name > ob1^.name THEN ob0 := ob1; ob1 := ob0^.right; left := FALSE
  314.                 ELSE (*double def*) err(1); ob0 := ob1; ob1 := ob0^.right
  315.                 END
  316.             ELSE (*insert*) ob1 := NewObj(); ob1^.leaf := TRUE;
  317.                 IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ;
  318.                 ob1^.left := NIL; ob1^.right := NIL; COPY(name, ob1^.name);
  319.                 ob1^.mnolev := topScope^.mnolev; EXIT
  320.             END
  321.         END ;
  322.         obj := ob1
  323.     END Insert;
  324.     PROCEDURE OpenScope*(level: SHORTINT; owner: Object);
  325.         VAR head: Object;
  326.     BEGIN head := NewObj();
  327.         head^.mode := Head; head^.mnolev := level; head^.link := owner;
  328.         IF owner # NIL THEN owner^.scope := head END ;
  329.         head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head
  330.     END OpenScope;
  331.     PROCEDURE CloseScope*;
  332.     BEGIN topScope := topScope^.left
  333.     END CloseScope;
  334.     PROCEDURE InsertImport(obj, root: Object; VAR old: Object);
  335.         VAR ob0, ob1: Object; left: BOOLEAN;
  336.     BEGIN ob0 := root; ob1 := ob0^.right; left := FALSE;
  337.         LOOP
  338.             IF ob1 # NIL THEN
  339.                 IF obj^.name < ob1^.name THEN ob0 := ob1; ob1 := ob1^.left; left := TRUE
  340.                 ELSIF obj^.name > ob1^.name THEN ob0 := ob1; ob1 := ob1^.right; left := FALSE
  341.                 ELSE old := ob1; EXIT
  342.                 END
  343.             ELSE ob1 := obj;
  344.                 IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ;
  345.                 ob1^.left := NIL; ob1^.right := NIL; ob1^.mnolev := root^.mnolev; old := NIL; EXIT
  346.             END
  347.         END
  348.     END InsertImport;
  349.     PROCEDURE ReadId(VAR name: ARRAY OF CHAR; VAR len: LONGINT);
  350.         VAR i: INTEGER; ch: CHAR;
  351.     BEGIN i := 0;
  352.         REPEAT
  353.             OPM.SymRCh(ch); name[i] := ch; INC(i)
  354.         UNTIL ch = 0X;
  355.         len := i
  356.     END ReadId;
  357.     PROCEDURE WriteId(VAR name: ARRAY OF CHAR);
  358.         VAR i: INTEGER; ch: CHAR;
  359.     BEGIN i := 0;
  360.         REPEAT ch := name[i]; OPM.SymWCh(ch); INC(i)
  361.         UNTIL ch = 0X
  362.     END WriteId;
  363.     PROCEDURE Import*(VAR aliasName, impName, selfName: OPS.Name);
  364.         VAR i, m, s, class: INTEGER;
  365.                 k, len: LONGINT; rval: REAL;
  366.                 ch: CHAR; done: BOOLEAN;
  367.                 nofLmod, strno, parlev, fldlev: INTEGER;
  368.                 obj, head, old: Object;
  369.                 typ: Struct;
  370.                 ext: ConstExt;
  371.                 mname: OPS.Name;
  372.                 LocMod:  ARRAY maxImps + 1 OF Object;
  373.                 struct:  ARRAY maxStruct OF Struct;
  374.                 param, lastpar, fldlist, lastfld: ARRAY 6 OF Object;
  375.         PROCEDURE reverseList(p: Object; mnolev: SHORTINT);
  376.             VAR q, r: Object;
  377.         BEGIN q := NIL;
  378.             WHILE p # NIL DO p^.mnolev := mnolev;
  379.                 r := p^.link; p^.link := q; q := p; p := r
  380.             END
  381.         END reverseList;
  382.     BEGIN nofLmod := 0; strno := firstStr;
  383.         parlev := -1; fldlev := -1;
  384.         IF impName = "SYSTEM" THEN SYSimported := TRUE;
  385.             Insert(aliasName, obj); obj^.mode := Mod; obj^.mnolev := 0; obj^.scope := syslink;
  386.             obj^.adr := 0; obj^.typ := notyp
  387.         ELSE OPM.OldSym(impName, FALSE, done);
  388.             IF done THEN
  389.                 struct[Undef] := undftyp; struct[Byte] := bytetyp;
  390.                 struct[Bool] := booltyp;  struct[Char] := chartyp;
  391.                 struct[SInt] := sinttyp;  struct[Int] := inttyp;
  392.                 struct[LInt] := linttyp;  struct[Real] := realtyp;
  393.                 struct[LReal] := lrltyp;  struct[Set] := settyp;
  394.                 struct[String] := stringtyp; struct[NilTyp] := niltyp;
  395.                 struct[NoTyp] := notyp;
  396.                 struct[Pointer] := sysptrtyp;
  397.                 NEW(head); (*for bound procedures*)
  398.                 LOOP (*read next item from symbol file*)
  399.                     OPM.SymRTag(class);
  400.                     IF OPM.eofSF() THEN EXIT END ;
  401.                     IF (class < 8) OR (class = 23) OR (class = 25) THEN (*object*)
  402.                         obj := NewObj(); m := 0;
  403.                         OPM.SymRTag(s); obj^.typ := struct[s];
  404.                         CASE class OF
  405.                            1:
  406.                             obj^.mode := Con; obj^.conval := NewConst();
  407.                             CASE obj^.typ^.form OF
  408.                               Byte, Char:
  409.                                 OPM.SymRCh(ch); obj^.conval^.intval := ORD(ch)
  410.                             | SInt, Bool:
  411.                                 OPM.SymRCh(ch); i := ORD(ch);
  412.                                 IF i > OPM.MaxSInt THEN i := i + 2*OPM.MinSInt END ;
  413.                                 obj^.conval^.intval := i
  414.                             | Int:
  415.                                 OPM.SymRInt(obj^.conval^.intval)
  416.                             | LInt:
  417.                                 OPM.SymRLInt(obj^.conval^.intval)
  418.                             | Set:
  419.                                 OPM.SymRSet(obj^.conval^.setval)
  420.                             | Real:
  421.                                 OPM.SymRReal(rval);
  422.                                 obj^.conval^.realval := rval;
  423.                                 obj^.conval^.intval := OPM.ConstNotAlloc
  424.                             | LReal:
  425.                                 OPM.SymRLReal(obj^.conval^.realval);
  426.                                 obj^.conval^.intval := OPM.ConstNotAlloc
  427.                             | String:
  428.                                 obj^.conval^.ext := NewExt();
  429.                                 ReadId(obj^.conval^.ext^, obj^.conval^.intval2);
  430.                                 obj^.conval^.intval := OPM.ConstNotAlloc
  431.                             | NilTyp:
  432.                                 obj^.conval^.intval := OPM.nilval
  433.                             END
  434.                         | 2, 3:
  435.                             obj^.mode := Typ; OPM.SymRTag(m);
  436.                             IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END ;
  437.                             IF class = 2 THEN obj^.vis := external ELSE obj^.vis := internal END
  438.                         | 4, 23:
  439.                             obj^.mode := Var;
  440.                             IF OPM.ExpVarAdr THEN OPM.SymRLInt(obj^.adr)
  441.                             ELSE OPM.SymRTag(s); obj^.adr := s
  442.                             END ;
  443.                             IF class = 23 THEN obj^.vis := externalR ELSE obj^.vis := external END
  444.                         | 5, 6, 7, 25:
  445.                             obj^.conval := NewConst();
  446.                             IF class = 5 THEN obj^.mode := IProc; OPM.SymRTag(s); obj^.adr := s
  447.                             ELSIF class = 6 THEN obj^.mode := XProc; OPM.SymRTag(s); obj^.adr := s
  448.                             ELSIF class = 7 THEN  obj^.mode := CProc; ext := NewExt(); obj^.conval^.ext := ext;
  449.                                 OPM.SymRCh(ch); s := ORD(ch); ext^[0] := ch; i := 1; obj^.adr := 0;
  450.                                 WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END
  451.                             ELSE obj^.mode := TProc; obj^.vis := external; OPM.SymRTag(s); typ := struct[s];
  452.                                 OPM.SymRTag(i); OPM.SymRTag(s); obj^.adr := 10000H*i + s
  453.                             END ;
  454.                             obj^.linkadr := OPM.LANotAlloc;    (* link adr *)
  455.                             obj^.conval^.intval := -1;
  456.                             reverseList(lastpar[parlev], LocMod[0]^.mnolev);
  457.                             obj^.link := param[parlev]^.right; DEC(parlev)
  458.                         END ;
  459.                         ReadId(obj^.name, len);
  460.                         IF class = 25 THEN
  461.                             head^.right := typ^.link; head^.mnolev := -typ^.mno; InsertImport(obj, head, old); typ^.link := head^.right
  462.                         ELSE InsertImport(obj, LocMod[m], old)
  463.                         END ;
  464.                         IF (old # NIL) & (obj^.mode = Typ) THEN struct[s] := old^.typ END
  465.                     ELSIF class < 13 THEN (*structure*)
  466.                         typ := NewStr(Undef, Basic); OPM.SymRTag(s); typ^.BaseTyp := struct[s];
  467.                         OPM.SymRTag(s); typ^.mno := -LocMod[s]^.mnolev;
  468.                         CASE class OF
  469.                           8:
  470.                             typ^.form := Pointer; typ^.size := OPM.PointerSize; typ^.n := 0
  471.                         | 9:
  472.                             typ^.form := ProcTyp; typ^.size := OPM.ProcSize; 
  473.                             reverseList(lastpar[parlev], -typ^.mno);
  474.                             typ^.link := param[parlev]^.right; DEC(parlev)
  475.                         | 10:
  476.                             typ^.form := Comp; typ^.comp := Array; OPM.SymRLInt(typ^.size);
  477.                             typ^.n := typ^.size DIV typ^.BaseTyp^.size
  478.                         | 11:
  479.                             typ^.form := Comp; typ^.comp := DynArr;
  480.                             OPM.SymRLInt(typ^.size); OPM.SymRInt(typ^.offset);
  481.                             IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1
  482.                             ELSE typ^.n := 0
  483.                             END
  484.                         | 12:
  485.                             typ^.form := Comp; typ^.comp := Record;
  486.                             OPM.SymRLInt(typ^.size); typ^.n := 0;
  487.                             reverseList(lastfld[fldlev], -typ^.mno); typ^.link := fldlist[fldlev]^.right; DEC(fldlev);
  488.                             IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL; typ^.extlev := 0
  489.                             ELSE typ^.extlev := typ^.BaseTyp^.extlev + 1
  490.                             END ;
  491.                             OPM.SymRInt(typ^.tdadr)
  492.                         END ;
  493.                         struct[strno] := typ; INC(strno)
  494.                     ELSIF class = 13 THEN (*parameter list start*)
  495.                         obj := NewObj(); obj^.mode := Head; obj^.right := NIL;
  496.                         IF parlev < 5 THEN INC(parlev); param[parlev] := obj; lastpar[parlev] := NIL
  497.                         ELSE err(229)
  498.                         END
  499.                     ELSIF class < 16 THEN (*parameter*)
  500.                         obj := NewObj();
  501.                         IF class = 14 THEN obj^.mode := Var ELSE obj^.mode := VarPar END ;
  502.                         OPM.SymRTag(s); obj^.typ := struct[s];
  503.                         IF OPM.ExpParAdr THEN OPM.SymRLInt(obj^.adr) END ;
  504.                         ReadId(obj^.name, len);
  505.                         obj^.link := lastpar[parlev]; lastpar[parlev] := obj;
  506.                         IF param[parlev]^.right = NIL THEN param[parlev]^.right := obj END
  507.                     ELSIF class = 16 THEN (*start field list*)
  508.                         obj := NewObj(); obj^.mode := Head; obj^.right := NIL;
  509.                         IF fldlev < 5 THEN INC(fldlev); fldlist[fldlev] := obj; lastfld[fldlev] := NIL
  510.                         ELSE err(229)
  511.                         END
  512.                     ELSIF (class = 17) OR (class = 24) THEN (*field*)
  513.                         obj := NewObj(); obj^.mode := Fld; OPM.SymRTag(s);
  514.                         obj^.typ := struct[s]; OPM.SymRLInt(obj^.adr);
  515.                         ReadId(obj^.name, len);
  516.                         obj^.link := lastfld[fldlev]; lastfld[fldlev] := obj;
  517.                         InsertImport(obj, fldlist[fldlev], old);
  518.                         IF class = 24 THEN obj^.vis := externalR ELSE obj^.vis := external END
  519.                     ELSIF (class = 18) OR (class = 19) THEN (*hidden pointer or proc*)
  520.                         obj := NewObj(); obj^.mode := Fld; OPM.SymRLInt(obj^.adr);
  521.                         IF class = 18 THEN obj^.name := OPM.HdPtrName
  522.                         ELSE obj^.name := OPM.HdProcName
  523.                         END ;
  524.                         obj^.typ := notyp; obj^.vis := internal;
  525.                         obj^.link := lastfld[fldlev]; lastfld[fldlev] := obj;
  526.                         IF fldlist[fldlev]^.right = NIL THEN
  527.                             fldlist[fldlev]^.right := obj
  528.                         END
  529.                     ELSIF class = 20 THEN (*fixup pointer typ*)
  530.                         OPM.SymRTag(s); typ := struct[s]; OPM.SymRTag(s);
  531.                         IF typ^.BaseTyp = undftyp THEN typ^.BaseTyp := struct[s] END
  532.                     ELSIF class = 21 THEN (*sysflag*)
  533.                         OPM.SymRTag(s); typ := struct[s]; OPM.SymRTag(s); typ^.sysflag := s
  534.                     ELSIF class = 22 THEN (*module anchor*)
  535.                         OPM.SymRLInt(k); ReadId(mname, len);
  536.                         IF mname = selfName THEN err(154) END ;
  537.                         i := 0;
  538.                         WHILE (i < nofGmod) & (mname # GlbMod[i]^.name) DO
  539.                             INC(i)
  540.                         END ;
  541.                         IF i < nofGmod THEN (*module already present*)
  542.                             IF k # GlbMod[i]^.adr THEN err(150) END ;
  543.                             obj := GlbMod[i]
  544.                         ELSE obj := NewObj();
  545.                             IF nofGmod < maxImps THEN GlbMod[nofGmod] := obj; INC(nofGmod)
  546.                             ELSE err(227)
  547.                             END ;
  548.                             obj^.mode := NotYetExp; COPY(mname, obj^.name);
  549.                             obj^.adr := k; obj^.mnolev := -nofGmod; obj^.right := NIL
  550.                         END ;
  551.                         IF nofLmod < maxImps + 1 THEN LocMod[nofLmod] := obj; INC(nofLmod)
  552.                         ELSE err(227)
  553.                         END
  554.                     ELSIF class = 26 THEN (*nof methods*)
  555.                         OPM.SymRTag(s); typ := struct[s]; OPM.SymRTag(s); typ^.n := s
  556.                     ELSIF class = 27 THEN (*hidden method*)
  557.                         obj := NewObj(); obj^.mode := TProc; obj^.name := OPM.HdTProcName; obj^.typ := undftyp;
  558.                         OPM.SymRTag(s); typ := struct[s]; obj^.mnolev := -typ^.mno;
  559.                         OPM.SymRTag(i); OPM.SymRTag(s); obj^.adr := 10000H*i + s;
  560.                         obj^.linkadr := OPM.LANotAlloc; obj^.vis := internal;
  561.                         obj^.link := NewObj(); obj^.link^.typ := typ; old := typ^.link;
  562.                         IF old = NIL THEN typ^.link := obj
  563.                         ELSE WHILE old^.left # NIL DO old := old^.left END ;
  564.                             old^.left := obj
  565.                         END
  566.                     END
  567.                 END (*LOOP*) ;
  568.                 Insert(aliasName, obj);
  569.                 obj^.mode := Mod; obj^.scope := LocMod[0]^.right;
  570.                 obj^.mnolev  := LocMod[0]^.mnolev; obj^.typ := notyp;
  571.                 OPM.CloseOldSym
  572.             END
  573.         END
  574.     END Import;
  575.     PROCEDURE^ OutStr(typ: Struct);
  576.     PROCEDURE^ OutObjs(obj: Object);
  577.     PROCEDURE ^OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
  578.     PROCEDURE OutPars(par: Object);
  579.     BEGIN
  580.         OPM.SymWTag(13);
  581.         WHILE par # NIL DO
  582.             OutStr(par^.typ);
  583.             IF par^.mode = Var THEN OPM.SymWTag(14) ELSE OPM.SymWTag(15) END ;
  584.             OPM.SymWTag(par^.typ^.ref);
  585.             IF OPM.ExpParAdr THEN OPM.SymWLInt(par^.adr) END ;
  586.             WriteId(par^.name); par := par^.link
  587.         END
  588.     END OutPars;
  589.     PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: LONGINT);
  590.         VAR i, j, n: LONGINT; btyp: Struct;
  591.     BEGIN
  592.         IF typ^.comp = Record THEN OutFlds(typ^.link, adr, FALSE)
  593.         ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n;
  594.             WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ;
  595.             IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN
  596.                 j := nofhdfld; OutHdFld(btyp, fld, adr);
  597.                 IF j # nofhdfld THEN i := 1;
  598.                     WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO
  599.                         INC(adr, btyp^.size); OutHdFld(btyp, fld, adr); INC(i)
  600.                     END
  601.                 END
  602.             END
  603.         ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN
  604.             OPM.SymWTag(18); OPM.SymWLInt(adr); INC(nofhdfld)
  605.         ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN
  606.             OPM.SymWTag(19); OPM.SymWLInt(adr); INC(nofhdfld)
  607.         END
  608.     END OutHdFld;
  609.     PROCEDURE OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
  610.     BEGIN
  611.         IF visible THEN OPM.SymWTag(16) END ;
  612.         WHILE (fld # NIL) & (fld^.mode = Fld) DO
  613.             IF (fld^.vis # internal) & visible THEN
  614.                 OutStr(fld^.typ);
  615.                 IF fld^.vis = external THEN OPM.SymWTag(17) ELSE OPM.SymWTag(24) END ;
  616.                 OPM.SymWTag(fld^.typ^.ref); OPM.SymWLInt(fld^.adr); WriteId(fld^.name)
  617.             ELSE OutHdFld(fld^.typ, fld, fld^.adr + adr)
  618.             END ;
  619.             fld := fld^.link
  620.         END
  621.     END OutFlds;
  622.     PROCEDURE OutStr(typ: Struct);
  623.         VAR m, em, r: INTEGER; btyp: Struct; mod: Object;
  624.     BEGIN
  625.         IF typ^.ref < 0 THEN OPM.Mark(234, typ^.txtpos)
  626.         ELSIF typ^.ref = 0 THEN
  627.             typ^.ref := -1;
  628.             m := typ^.mno; btyp := typ^.BaseTyp;
  629.             IF m > 0 THEN mod := GlbMod[m-1]; em := mod^.mode;
  630.                 IF em = NotYetExp THEN
  631.                     mod^.mode := nofExp; m := nofExp; INC(nofExp);
  632.                     OPM.SymWTag(22); OPM.SymWLInt(mod^.adr); WriteId(mod^.name)
  633.                 ELSE m := em
  634.                 END
  635.             END ;
  636.             CASE typ^.form OF
  637.               Undef .. NoTyp:
  638.             | Pointer:
  639.                 OPM.SymWTag(8);
  640.                 IF btyp^.ref > 0 THEN OPM.SymWTag(btyp^.ref)
  641.                 ELSE OPM.SymWTag(Undef);
  642.                     IF udpinx < maxUndPtr THEN undPtr[udpinx] := typ; INC(udpinx) ELSE err(224) END
  643.                 END ;
  644.                 OPM.SymWTag(m)
  645.             | ProcTyp:
  646.                 OutStr(btyp); OutPars(typ^.link); OPM.SymWTag(9);
  647.                 OPM.SymWTag(btyp^.ref); OPM.SymWTag(m)
  648.             | Comp:
  649.                 IF typ^.comp = Array THEN
  650.                     OutStr(btyp); OPM.SymWTag(10); OPM.SymWTag(btyp^.ref);
  651.                     OPM.SymWTag(m); OPM.SymWLInt(typ^.size)
  652.                 ELSIF typ^.comp = DynArr THEN
  653.                     OutStr(btyp); OPM.SymWTag(11); OPM.SymWTag(btyp^.ref); OPM.SymWTag(m);
  654.                     OPM.SymWLInt(typ^.size); OPM.SymWInt(typ^.offset)
  655.                 ELSE (* typ^.comp = Record *)
  656.                     IF btyp = NIL THEN r := NoTyp
  657.                     ELSE OutStr(btyp); r := btyp^.ref
  658.                     END ;
  659.                     nofhdfld := 0; OutFlds(typ^.link, 0, TRUE);
  660.                     IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(221, typ^.txtpos) END ;
  661.                     OPM.SymWTag(12); OPM.SymWTag(r); OPM.SymWTag(m);
  662.                     OPM.SymWLInt(typ^.size);
  663.                     OPM.SymWInt(typ^.tdadr)
  664.                 END
  665.             END ;
  666.             IF typ^.sysflag # 0 THEN OPM.SymWTag(21); OPM.SymWTag(strno); OPM.SymWTag(typ^.sysflag) END ;
  667.             IF (typ^.comp = Record) & (typ^.n > 0) THEN
  668.                 OPM.SymWTag(26); OPM.SymWTag(strno); OPM.SymWTag(SHORT(typ^.n))
  669.             END ;
  670.             IF typ^.strobj # NIL THEN
  671.                 IF typ^.strobj^.vis # internal THEN OPM.SymWTag(2) ELSE OPM.SymWTag(3) END ;
  672.                 OPM.SymWTag(strno); OPM.SymWTag(m); WriteId(typ^.strobj^.name)
  673.             END ;
  674.             typ^.ref := strno; INC(strno);
  675.             IF strno > maxStruct THEN err(228) END ;
  676.             IF typ^.comp = Record THEN OutObjs(typ^.link) END (*bound procedures*)
  677.         END
  678.     END OutStr;
  679.     PROCEDURE OutTyps(obj: Object);
  680.         VAR strobj: Object;
  681.     BEGIN
  682.         IF obj # NIL THEN
  683.             OutTyps(obj^.left); 
  684.             IF (obj^.vis # internal) & (obj^.mode = Typ) THEN
  685.                 IF obj^.typ^.ref = 0 THEN OutStr(obj^.typ) END ;
  686.                 strobj := obj^.typ^.strobj;
  687.                 IF (strobj # obj) & (strobj # NIL) THEN
  688.                     OPM.SymWTag(2); OPM.SymWTag(obj^.typ^.ref); OPM.SymWTag(0); WriteId(obj^.name)
  689.                 END
  690.             END ;
  691.             OutTyps(obj^.right)
  692.         END
  693.     END OutTyps;
  694.     PROCEDURE OutObjs(obj: Object);
  695.         VAR f, m: INTEGER; rval: REAL; ext: ConstExt; typ: Struct; k: LONGINT;
  696.     BEGIN
  697.         IF obj # NIL THEN
  698.             OutObjs(obj^.left);
  699.             IF (obj^.vis # internal) OR (obj^.mode = TProc) THEN
  700.                 IF obj^.mode = Var THEN
  701.                     OutStr(obj^.typ);
  702.                     IF obj^.vis = externalR THEN OPM.SymWTag(23) ELSE OPM.SymWTag(4) END ;
  703.                     OPM.SymWTag(obj^.typ^.ref);
  704.                     IF OPM.ExpVarAdr THEN OPM.SymWLInt(obj^.adr)
  705.                     ELSE OPM.SymWTag(SHORT(obj^.adr))
  706.                     END ;
  707.                     WriteId(obj^.name)
  708.                 ELSIF obj^.mode = Con THEN
  709.                     OPM.SymWTag(1); f := obj^.typ^.form; OPM.SymWTag(f);
  710.                     CASE f OF
  711.                        Byte, Char:
  712.                         OPM.SymWCh(CHR(obj^.conval^.intval))
  713.                     | Bool, SInt:
  714.                         k := obj^.conval^.intval;
  715.                         IF k < 0 THEN k := k - 2*OPM.MinSInt END ;
  716.                         OPM.SymWCh(CHR(k))
  717.                     | Int:
  718.                         OPM.SymWInt(obj^.conval^.intval)
  719.                     | LInt:
  720.                         OPM.SymWLInt(obj^.conval^.intval)
  721.                     | Set:
  722.                         OPM.SymWSet(obj^.conval^.setval)
  723.                     | Real:
  724.                         rval := SHORT(obj^.conval^.realval);
  725.                         OPM.SymWReal(rval)
  726.                     | LReal:
  727.                         OPM.SymWLReal(obj^.conval^.realval)
  728.                     | String:
  729.                         WriteId(obj^.conval^.ext^)
  730.                     | NilTyp:
  731.                     ELSE err(127)
  732.                     END ;
  733.                     WriteId(obj^.name)
  734.                 ELSIF obj^.mode = XProc THEN
  735.                     OutStr(obj^.typ); OutPars(obj^.link); OPM.SymWTag(6);
  736.                     OPM.SymWTag(obj^.typ^.ref); OPM.SymWTag(SHORT(obj^.adr)); WriteId(obj^.name)
  737.                 ELSIF obj^.mode = IProc THEN
  738.                     OutStr(obj^.typ); OutPars(obj^.link); OPM.SymWTag(5);
  739.                     OPM.SymWTag(obj^.typ^.ref); OPM.SymWTag(SHORT(obj^.adr)); WriteId(obj^.name)
  740.                 ELSIF obj^.mode = CProc THEN
  741.                     OutStr(obj^.typ); OutPars(obj^.link); OPM.SymWTag(7);
  742.                     OPM.SymWTag(obj^.typ^.ref); ext := obj^.conval^.ext;
  743.                     m := ORD(ext^[0]); f := 1; OPM.SymWCh(CHR(m));
  744.                     WHILE f <= m DO OPM.SymWCh(ext^[f]); INC(f) END ;
  745.                     WriteId(obj^.name)
  746.                 ELSIF obj^.mode = TProc THEN
  747.                     typ := obj^.link^.typ; IF typ^.form = Pointer THEN typ := typ^.BaseTyp END ;
  748.                     IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = internal) THEN
  749.                         OPM.Mark(109, typ^.txtpos)
  750.                         (* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *)
  751.                     END ;
  752.                     IF OPM.ExpHdTProc OR (obj^.vis # internal) THEN
  753.                         IF obj^.vis # internal THEN OutStr(obj^.typ); OutPars(obj^.link);
  754.                             OPM.SymWTag(25); OPM.SymWTag(obj^.typ^.ref)
  755.                         ELSE OPM.SymWTag(27)
  756.                         END ;
  757.                         OPM.SymWTag(typ^.ref); OPM.SymWTag(SHORT(obj^.adr DIV 10000H));
  758.                         OPM.SymWTag(SHORT(obj^.adr MOD 10000H));
  759.                         IF obj^.vis # internal THEN WriteId(obj^.name) END
  760.                     END
  761.                 END
  762.             END ;
  763.             OutObjs(obj^.right)
  764.         END
  765.     END OutObjs;
  766.     PROCEDURE Export*(VAR modName: OPS.Name; VAR newSF: BOOLEAN; VAR key: LONGINT);
  767.         VAR i: INTEGER; done: BOOLEAN;
  768.             oldkey: LONGINT;
  769.             typ: Struct;
  770.     BEGIN
  771.         OPM.NewSym(modName, done);
  772.         IF done THEN strno := firstStr;
  773.             OPM.SymWTag(22); OPM.SymWLInt(key); WriteId(modName); nofExp := 1;
  774.             OutTyps(topScope^.right); OutObjs(topScope^.right); i := 0;
  775.             WHILE i < udpinx DO
  776.                 typ := undPtr[i]; undPtr[i] := NIL(*garbage collection*); INC(i); OutStr(typ^.BaseTyp);
  777.                 OPM.SymWTag(20); (*fixup*)
  778.                 OPM.SymWTag(typ^.ref); OPM.SymWTag(typ^.BaseTyp^.ref)
  779.             END ;
  780.             IF OPM.noerr THEN
  781.                 OPM.OldSym(modName, TRUE, done);
  782.                 IF done THEN (*compare*)
  783.                     IF OPM.EqualSym(oldkey) THEN OPM.DeleteNewSym; newSF := FALSE; key := oldkey
  784.                     ELSIF newSF THEN OPM.RegisterNewSym(modName)
  785.                     ELSE OPM.DeleteNewSym; err(155)
  786.                     END
  787.                 ELSE OPM.RegisterNewSym(modName); newSF := TRUE
  788.                 END
  789.             ELSE OPM.DeleteNewSym; newSF := FALSE
  790.             END
  791.         ELSE newSF := FALSE
  792.         END
  793.     END Export;
  794.     PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT);
  795.     BEGIN typ := NewStr(form, Basic); typ^.ref := form; typ^.size := OPM.ByteSize;
  796.         typ^.tdadr := 0; typ^.offset := 0; typ^.strobj := NewObj()
  797.     END InitStruct;
  798.     PROCEDURE EnterBoolConst(name: OPS.Name; value: LONGINT);
  799.         VAR obj: Object;
  800.     BEGIN Insert(name, obj); obj^.conval := NewConst();
  801.         obj^.mode := Con; obj^.typ := booltyp; obj^.conval^.intval := value
  802.     END EnterBoolConst;
  803.     PROCEDURE EnterTyp(name: OPS.Name; form: SHORTINT; size: INTEGER; VAR res: Struct);
  804.         VAR obj: Object; typ: Struct;
  805.     BEGIN Insert(name, obj);
  806.         typ := NewStr(form, Basic); obj^.mode := Typ; obj^.typ := typ; obj^.vis := external;
  807.         typ^.strobj := obj; typ^.size := size; typ^.tdadr := 0; typ^.offset := 0; typ^.ref := form; res := typ
  808.     END EnterTyp;
  809.     PROCEDURE EnterProc(name: OPS.Name; num: INTEGER);
  810.         VAR obj: Object;
  811.     BEGIN Insert(name, obj);
  812.         obj^.mode := SProc; obj^.typ := notyp; obj^.adr := num
  813.     END EnterProc;
  814. BEGIN
  815.     topScope := NIL; OpenScope(0, NIL);  OPM.errpos := 0;
  816.     InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
  817.     InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp);
  818.     undftyp^.BaseTyp := undftyp;
  819.     (*initialization of module SYSTEM*)
  820.     EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp);
  821.     EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp);
  822.     EnterProc("ADR", adrfn);
  823.     EnterProc("CC", ccfn);
  824.     EnterProc("LSH", lshfn);
  825.     EnterProc("ROT", rotfn);
  826.     EnterProc("GET", getfn);
  827.     EnterProc("PUT", putfn);
  828.     EnterProc("GETREG", getrfn);
  829.     EnterProc("PUTREG", putrfn);
  830.     EnterProc("BIT", bitfn);
  831.     EnterProc("VAL", valfn);
  832.     EnterProc("NEW", sysnewfn);
  833.     EnterProc("MOVE", movefn);
  834.     EnterProc("CALL", callfn);        (*<<OJ for SYSTEM.CALL *)
  835.     syslink := topScope^.right;
  836.     universe := topScope; topScope^.right := NIL;
  837.     EnterTyp("CHAR", Char, OPM.CharSize, chartyp);
  838.     EnterTyp("SET", Set, OPM.SetSize, settyp);
  839.     EnterTyp("REAL", Real, OPM.RealSize, realtyp);
  840.     EnterTyp("INTEGER", Int, OPM.IntSize, inttyp);
  841.     EnterTyp("LONGINT",  LInt, OPM.LIntSize, linttyp);
  842.     EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp);
  843.     EnterTyp("SHORTINT", SInt, OPM.SIntSize, sinttyp);
  844.     EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp);
  845.     EnterBoolConst("FALSE", 0);    (* 0 and 1 are compiler internal representation only *)
  846.     EnterBoolConst("TRUE",  1);
  847.     EnterProc("HALT", haltfn);
  848.     EnterProc("NEW", newfn);
  849.     EnterProc("ABS", absfn);
  850.     EnterProc("CAP", capfn);
  851.     EnterProc("ORD", ordfn);
  852.     EnterProc("ENTIER", entierfn);
  853.     EnterProc("ODD", oddfn);
  854.     EnterProc("MIN", minfn);
  855.     EnterProc("MAX", maxfn);
  856.     EnterProc("CHR", chrfn);
  857.     EnterProc("SHORT", shortfn);
  858.     EnterProc("LONG", longfn);
  859.     EnterProc("SIZE", sizefn);
  860.     EnterProc("INC", incfn);
  861.     EnterProc("DEC", decfn);
  862.     EnterProc("INCL", inclfn);
  863.     EnterProc("EXCL", exclfn);
  864.     EnterProc("LEN", lenfn);
  865.     EnterProc("COPY", copyfn);
  866.     EnterProc("ASH", ashfn);
  867.     EnterProc("ASSERT", assertfn) 
  868. END OPT.
  869.